library(stargazer)
library(htmltools)
library(tidyverse)
library(ggplot2)
library(corrplot)
library(hrbrthemes)
library(viridis)
library(forcats)
library(plotly)
library(rjson)
library(lmtest)
library(knitr)
library(kableExtra)
library(shiny)
library(PerformanceAnalytics)
library(DT)
library(reshape2)
set.seed(2023)
setwd("D:/labSem5/ProjektAnaliza")
dane <- read.csv("D:\\labSem5\\ProjektAnaliza\\dane.csv", sep=",")
sum(is.na.data.frame(dane))%>%
kable()
| x |
|---|
| 0 |
W zbiorze nie występują braki danych
Ten zbiór danych pokazuje ilość czasu, jaką ludzie w USA zgłaszają, że spędzają w towarzystwie innych osób, w zależności od ich wieku.Dane pochodzą z ankiet dotyczących wykorzystania czasu, w których ludzie są proszeni o wymienienie wszystkich czynności wykonywanych przez nich w ciągu całego dnia oraz osób, które były obecne podczas każdej czynności. Dane są przedstawione w minutach, wiek badanych osób waha się od 15 do 80 lat . Dlatego że dane są pobrane tylko na terenie USA tworzymy tabele tylko z potrzebujących nam danych, dlatego usuwamy 3 pierwsze kolumny.
dane <- dane[-67, -c(1,2,3)]
colnames(dane)<-c('wiek','osobnie','przyjaciele','dzieci','rodzina','partner','współpracownicy')
data_rounded <- dane %>% mutate_at(vars(osobnie:współpracownicy), round, 2)
R<-datatable(data_rounded , options = list(), class = "display",
style = "auto", width = NULL, height = NULL, elementId = NULL,
fillContainer = getOption("DT.fillContainer", NULL),
autoHideNavigation = getOption("DT.autoHideNavigation", NULL),
selection = c("multiple", "single", "none"), extensions = list(),
plugins = NULL, editable = FALSE)
R
wiek
osobnie - czas spędzony osobiście
przyjaciele - czas spędzony z przyjaciółmi
dzieci - czas spędzony z dziećmi
rodzina - czas spędzony z rodziną
partner - czas spędzony z partnerem/partnerką
współpracownicy - czas spędzony z kolegami
plot_ly(data = dane, x = ~wiek, y = ~osobnie, name = "Osobnie", type = "scatter", mode = "lines+markers", line = list(width = 1))%>%
add_trace(y = ~przyjaciele, name = "Przyjaciele")%>%
add_trace(y = ~dzieci, name = "Dzieci")%>%
add_trace(y = ~rodzina, name = "Rodzina")%>%
add_trace(y = ~partner, name = "Partner")%>%
add_trace(y = ~współpracownicy, name = "Współpracownicy")%>%
layout(title = "Jak dużo i z kim spędzamy czas w ciągu naszego życia", xaxis = list(title = "Wiek"), yaxis = list(title = "Czas(min)"), font = t, hovermode = "x unified")
Z powstałego wykresu zauważamy, że zmienna osobnie mocno wyróżnia się swoim wzrostem w czasie w porównaniu z pozostałymi zmiennymi, które z kolei w większości albo zaczynają spadać zaraz po osiągnięciu maksimum, albo osiągają swoją maksymalną wartość w przedziale 30-40 lat, z kolei albo utrzymują trend i pozostają na mniej więcej tym samym poziomie, albo rozpoczynają swój spadek.
w15_25 <- subset(dane, wiek >= 15 & wiek <= 25)
w26_36 <- subset(dane, wiek >= 26 & wiek <= 36)
w37_47 <- subset(dane, wiek >= 37 & wiek <= 47)
w48_58 <- subset(dane, wiek >= 48 & wiek <= 58)
w59_69 <- subset(dane, wiek >= 59 & wiek <= 69)
w70_80 <- subset(dane, wiek >= 70 & wiek <= 80)
w15_25_mean_wiek <- as.numeric(mean(w15_25$wiek))
w26_36_mean_wiek <- as.numeric(mean(w26_36$wiek))
w37_47_mean_wiek <- as.numeric(mean(w37_47$wiek))
w48_58_mean_wiek <- as.numeric(mean(w48_58$wiek))
w59_69_mean_wiek <- as.numeric(mean(w59_69$wiek))
w70_80_mean_wiek <- as.numeric(mean(w70_80$wiek))
w15_25_mean <- as.numeric(mean(w15_25$osobnie))
w26_36_mean <- as.numeric(mean(w26_36$osobnie))
w37_47_mean <- as.numeric(mean(w37_47$osobnie))
w48_58_mean <- as.numeric(mean(w48_58$osobnie))
w59_69_mean <- as.numeric(mean(w59_69$osobnie))
w70_80_mean <- as.numeric(mean(w70_80$osobnie))
w15_25_mean_przyjaciele <- as.numeric(mean(w15_25$przyjaciele))
w26_36_mean_przyjaciele <- as.numeric(mean(w26_36$przyjaciele))
w37_47_mean_przyjaciele <- as.numeric(mean(w37_47$przyjaciele))
w48_58_mean_przyjaciele <- as.numeric(mean(w48_58$przyjaciele))
w59_69_mean_przyjaciele <- as.numeric(mean(w59_69$przyjaciele))
w70_80_mean_przyjaciele <- as.numeric(mean(w70_80$przyjaciele))
w15_25_mean_dzieci <- as.numeric(mean(w15_25$dzieci))
w26_36_mean_dzieci <- as.numeric(mean(w26_36$dzieci))
w37_47_mean_dzieci <- as.numeric(mean(w37_47$dzieci))
w48_58_mean_dzieci <- as.numeric(mean(w48_58$dzieci))
w59_69_mean_dzieci <- as.numeric(mean(w59_69$dzieci))
w70_80_mean_dzieci <- as.numeric(mean(w70_80$dzieci))
w15_25_mean_rodzina <- as.numeric(mean(w15_25$rodzina))
w26_36_mean_rodzina <- as.numeric(mean(w26_36$rodzina))
w37_47_mean_rodzina <- as.numeric(mean(w37_47$rodzina))
w48_58_mean_rodzina <- as.numeric(mean(w48_58$rodzina))
w59_69_mean_rodzina <- as.numeric(mean(w59_69$rodzina))
w70_80_mean_rodzina <- as.numeric(mean(w70_80$rodzina))
w15_25_mean_partner <- as.numeric(mean(w15_25$partner))
w26_36_mean_partner <- as.numeric(mean(w26_36$partner))
w37_47_mean_partner <- as.numeric(mean(w37_47$partner))
w48_58_mean_partner <- as.numeric(mean(w48_58$partner))
w59_69_mean_partner <- as.numeric(mean(w59_69$partner))
w70_80_mean_partner <- as.numeric(mean(w70_80$partner))
w15_25_mean_współpracownicy <- as.numeric(mean(w15_25$współpracownicy))
w26_36_mean_współpracownicy <- as.numeric(mean(w26_36$współpracownicy))
w37_47_mean_współpracownicy <- as.numeric(mean(w37_47$współpracownicy))
w48_58_mean_współpracownicy <- as.numeric(mean(w48_58$współpracownicy))
w59_69_mean_współpracownicy <- as.numeric(mean(w59_69$współpracownicy))
w70_80_mean_współpracownicy <- as.numeric(mean(w70_80$współpracownicy))
data <- data.frame(age_group = c("15-25", "26-36", "37-47", "48-58", "59-69", "70-80"),
osobnie = c(w15_25_mean, w26_36_mean, w37_47_mean, w48_58_mean, w59_69_mean, w70_80_mean),
przyjaciele = c(w15_25_mean_przyjaciele, w26_36_mean_przyjaciele, w37_47_mean_przyjaciele, w48_58_mean_przyjaciele,
w59_69_mean_przyjaciele, w70_80_mean_przyjaciele),
dzieci = c(w15_25_mean_dzieci, w26_36_mean_dzieci, w37_47_mean_dzieci, w48_58_mean_dzieci, w59_69_mean_dzieci,
w70_80_mean_dzieci),
rodzina = c(w15_25_mean_rodzina, w26_36_mean_rodzina, w37_47_mean_rodzina, w48_58_mean_rodzina, w59_69_mean_rodzina, w70_80_mean_rodzina),
partner = c(w15_25_mean_partner, w26_36_mean_partner, w37_47_mean_partner, w48_58_mean_partner, w59_69_mean_partner, w70_80_mean_partner),
współpracownicy = c(w15_25_mean_współpracownicy, w26_36_mean_współpracownicy, w37_47_mean_współpracownicy,
w48_58_mean_współpracownicy, w59_69_mean_współpracownicy, w70_80_mean_współpracownicy))
data_rounded2 <- data %>% mutate_at(vars(osobnie:współpracownicy), round, 2)
R1<-datatable(data_rounded2, options = list(), class = "display",
style = "auto", width = NULL, height = NULL, elementId = NULL,
fillContainer = getOption("DT.fillContainer", NULL),
autoHideNavigation = getOption("DT.autoHideNavigation", NULL),
selection = c("multiple", "single", "none"), extensions = list(),
plugins = NULL, editable = FALSE)
R1
ui <- fluidPage(
selectInput(inputId = "age_group", label = "Wybierz grupę wiekową",
choices = unique(data$age_group)),
plotOutput("pie_chart")
)
server <- function(input, output) {
filtered_data <- reactive({
data[data$age_group == input$age_group,]
})
filtered_data_melt <- reactive({
melt(filtered_data()[,c("osobnie", "przyjaciele", "dzieci", "rodzina", "partner", "współpracownicy")])
})
filtered_data_melt_new <- reactive({
filtered_data_melt() %>% mutate(percent = value / sum(value) * 100)
})
output$pie_chart <- renderPlot({
ggplot(filtered_data_melt_new(), aes(x = "", y = percent, fill = variable)) +
geom_bar(width = 1, stat = "identity") +
coord_polar("y", start = 0) +
ggtitle(paste("Relacje dla grupy wiekowej", input$age_group)) +
theme_void()+
scale_fill_manual(values = c("osobnie" = "#8dd3c7", "przyjaciele" = "#fb8072", "dzieci" = "yellow", "rodzina" = "#bebada", "partner" = "purple", "współpracownicy" = "pink"))+
geom_text(aes(label = paste(round(value/sum(value)*100),"%")), position = position_stack(vjust = 0.5))
})
}
shinyApp(ui = ui, server = server)
Z wykresu widzimy, że niezależnie od tego, w jakiej kategorii wiekowej się znajdujemy, najwięcej czasu spędzamy sami. Dlatego nie będziemy brać go pod uwagę przy dalszej analizie powstałego wykresu. W grupie wiekowej 15-25 lat najistotniejszą zmienną jest rodzina, co oznacza, że w tej grupie wiekowej najwięcej czasu spędzamy z rodziną. I tak dla kategorii 26-26 lat największe znaczenie mają dzieci (22%) i współpracownicy (20%), na trzecim miejscu jest partner (19%). Dla kategorii 37-47 obraz nie uległ większym zmianom, poza tym, że obecnie o 2% więcej czasu poświęca się partnerowi niż współpracownikowi (20% vs. 18%). Dla grupy wiekowej 48-58 lat nie ma zmian w zmiennych partner i współpracownik, w przeciwieństwie do odsetka czasu spędzanego z dziećmi, który spada do 11% w stosunku do pozostałych zmiennych. Dla kategorii wiekowej 59-69 lat główną kategorią jest partner, wyróżnia się on zdecydowanie i zajmuje 26% czasu, podczas gdy pozostałe omawiane zmienne nie przekraczają wartości 10%. w kategorii wiekowej 70-80 lat utrzymuje się ta sama tendencja, podczas gdy udział zmiennej partner wzrasta i wynosi już 29%, wartości pozostałych zmiennych wciąż spadają i nie przekraczają 7% dla każdej z nich. Z naszych obserwacji możemy więc wnioskować, że każdy okres czasu ma swoje główne zmienne, którym osoba poświęca procentowo więcej czasu niż pozostałym zmiennym. Ale która zmienna wyszłaby na prowadzenie, gdybyśmy wzięli pod uwagę cały dostępny nam okres czasu?
osobnie <- as.numeric(dane$osobnie)
OS <- sum(osobnie)
przyjaciele <- as.numeric(dane$przyjaciele)
PR <- sum(przyjaciele)
dzieci <- as.numeric(dane$dzieci)
DZ <- sum(dzieci)
rodzina <- as.numeric(dane$rodzina)
RO <- sum(rodzina)
partner <- as.numeric(dane$partner)
PA <- sum(partner)
wsprac <- as.numeric(dane$współpracownicy)
WS <- sum(wsprac)
df_sum <- data.frame(PR, DZ, RO, PA, WS)
df_sum%>%
kable()%>%
kable_paper()
| PR | DZ | RO | PA | WS |
|---|---|---|---|---|
| 3467.534 | 7786.216 | 5402.282 | 12083.65 | 8390.652 |
df_melt <- melt(df_sum)
ggplot(df_melt, aes(x = variable, y = value, fill = variable)) +
geom_col() +
xlab("Kategorii") +
ylab("Czas") +
ggtitle("Porównanie zmiennych") +
theme_classic() +
scale_fill_manual(values = c("PR" = "#fb8072", "DZ" = "yellow", "RO" = "#bebada", "PA" = "purple", "WS" = "pink"), labels = c("przyjaciele(PR)", "dzieci(DZ)", "rodzina(RO)", "partner(PA)", "współracownicy(WS)"))+
geom_text(aes(label = scales::percent(value/sum(value))), position = position_stack(vjust = 0.5), size = 4)
Z naszego wykresu wynika, że spośród zmiennych (bez zmiennej osobnie) najważniejsza w życiu jest zmienna partner (32,5%), następnie zmienna współpacownicy (22,6%) i dzieci (21%).
Prowadzimy statystyki opisowe dla naszego zbioru danych
df <- dane %>%
select(1:3)
op <- apply(dane,2, summary)
op <- rbind(op, St.dev=apply(df,2,sd))
as.data.frame(round(op,2))%>%
kable(caption = "Statystyki opisowe")
| wiek | osobnie | przyjaciele | dzieci | rodzina | partner | współpracownicy | |
|---|---|---|---|---|---|---|---|
| Min. | 15.00 | 193.31 | 28.92 | 23.46 | 47.98 | 0.00 | 3.25 |
| 1st Qu. | 31.25 | 268.40 | 35.91 | 55.58 | 57.39 | 180.28 | 46.15 |
| Median | 47.50 | 335.41 | 39.71 | 83.37 | 63.09 | 195.31 | 165.55 |
| Mean | 47.50 | 346.30 | 52.54 | 117.97 | 81.85 | 183.09 | 127.13 |
| 3rd Qu. | 63.75 | 431.62 | 50.63 | 190.26 | 71.74 | 230.65 | 186.33 |
| Max. | 80.00 | 485.83 | 137.75 | 266.08 | 267.12 | 276.13 | 215.61 |
| St.dev | 19.20 | 84.51 | 28.82 | 19.20 | 84.51 | 28.82 | 19.20 |
chart.Correlation(dane, histogram = TRUE, pch = "+")
Z tej tabeli widzimy, że najmocniejszą korelację mają pomiędzy sobą zmienne wiek i osobnie, ьożna też zauważyć, że pomiędzy zmiennymi wiek i osobnie widzimy coś przypominającego zależność liniową. Aby sprawdzić ten argument, utwórzmy nową ramkę danych, z którą utworzymy model liniowy.
df11 <- data.frame(dane$wiek, dane$osobnie)
R2<-datatable(df11, options = list(), class = "display",
style = "auto", width = NULL, height = NULL, elementId = NULL,
fillContainer = getOption("DT.fillContainer", NULL),
autoHideNavigation = getOption("DT.autoHideNavigation", NULL),
selection = c("multiple", "single", "none"), extensions = list(),
plugins = NULL, editable = FALSE)
R2
ggplot(df11, aes(x = df11$dane.wiek, y = df11$dane.osobnie)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
ggtitle("Liniowa zależność między czasem spędzonym osobnie a wiekiem")
model1 <- lm(formula = dane.wiek~dane.osobnie, data=df11)
summary(model1)
##
## Call:
## lm(formula = dane.wiek ~ dane.osobnie, data = df11)
##
## Residuals:
## Min 1Q Median 3Q Max
## -12.4153 -2.8292 0.1218 3.8708 9.6707
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -28.545386 2.589275 -11.02 <2e-16 ***
## dane.osobnie 0.219596 0.007267 30.22 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.951 on 64 degrees of freedom
## Multiple R-squared: 0.9345, Adjusted R-squared: 0.9335
## F-statistic: 913.1 on 1 and 64 DF, p-value: < 2.2e-16
cor_val <- cor(df11$dane.wiek, df11$dane.osobnie)
kable(data.frame(correlation = sprintf("%.2f (korelację pomiędzy wiek a osobnie)", cor_val)))%>%
kable_styling()
| correlation |
|---|
| 0.97 (korelację pomiędzy wiek a osobnie) |
Widzimy silną korelację między wiek a
osobnie co potwierdza podejrzenia o liniowej zależności. Z
podsumowania modelu możemy wyczytać, że zmienna dane.osobnie jest
istotna statystycznie, więc ma ona istotny wpływ na zmienną objaśnianą.
Współczynnik \(R^2\) jest bardzo bliski
jeden więc model faktycznie może być liniowy.
plot(model1, which=2)
plot(model1, which=3)
plot(model1, which=4)
plot(model1, which=5)
plot(model1, which=6)
shapiro.test(model1$residuals)
##
## Shapiro-Wilk normality test
##
## data: model1$residuals
## W = 0.97018, p-value = 0.1126
Test Shapiro Wilka nie odrzuca hipotezy o normalności reszt modelu(p-value > 0.05).
bptest(model1)
##
## studentized Breusch-Pagan test
##
## data: model1
## BP = 10.684, df = 1, p-value = 0.001081
gqtest(model1, order.by = fitted(model1), data=df11)
##
## Goldfeld-Quandt test
##
## data: model1
## GQ = 0.18487, df1 = 31, df2 = 31, p-value = 1
## alternative hypothesis: variance increases from segment 1 to 2
hmctest(model1)
##
## Harrison-McCabe test
##
## data: model1
## HMC = 0.83275, p-value = 1
Test Shapiro-Wilk i Breusch-Pagan sugerują, że hipoteza jednorodności wariancji jest spełniona. Natomiast test Goldfeld-Quandt oraz Harrison-McCabe` nie dostarczają dowodów przeciwko hipotezie jednorodności wariancji. Wszystkie wartości p-value są większe niż 0,05, co oznacza, że nie ma podstaw, aby odrzucić hipotezę jednorodności wariancji.
dwtest(model1, data=df11)
##
## Durbin-Watson test
##
## data: model1
## DW = 0.25797, p-value < 2.2e-16
## alternative hypothesis: true autocorrelation is greater than 0
bgtest(model1, order =3, data=df11)
##
## Breusch-Godfrey test for serial correlation of order up to 3
##
## data: model1
## LM test = 50.248, df = 3, p-value = 7.075e-11
Test Durbina-Watsona ma wartość p mniejszą niż 2.2e-16, co sugeruje, że istnieje dowód na pozytywną autokorelację w resztach modelu. Test Breusch-Godfrey ma bardzo niską wartość p, co wskazuje na istnienie korelacji szeregowej w resztach do rzędu 3. Te wyniki sugerują, że mogą wystąpić problemy z założeniami niezależności i stałej wariancji modelu regresji liniowej. Warto zauważyć, że wartość p dla testu bptest i hmctest jest większa niż 0.05, więc nie jesteśmy w stanie odrzucić hipotezy zerowej, że reszty mają stałą wariancję, i możemy uznać to założenie za spełnione.
resettest(model1, data=df11, type='regressor')
##
## RESET test
##
## data: model1
## RESET = 0.44379, df1 = 2, df2 = 62, p-value = 0.6436
raintest(model1)
##
## Rainbow test
##
## data: model1
## Rain = 27.786, df1 = 33, df2 = 31, p-value = 1.782e-15
harvtest(model1, order.by = ~fitted(model1))
##
## Harvey-Collier test
##
## data: model1
## HC = 0.026497, df = 63, p-value = 0.9789
Test RESET ma wartość p równą 0,6436, co sugeruje brak dowodów na istnienie nieliniowości. Jednak test Rainbow oraz test Harvey-Collier mają bardzo niskie wartości p, co wskazuje na istnienie heteroskedastyczności w resztach modelu. To sugeruje, że wariancja reszt może być zależna od dopasowanych wartości modelu. Te wyniki sugerują, że mogą występować problemy z założeniem jednorodności wariancji w regresji liniowej.
df_mean <- data.frame(wiek = c(w15_25_mean_wiek, w26_36_mean_wiek, w37_47_mean_wiek, w48_58_mean_wiek, w59_69_mean_wiek, w70_80_mean_wiek),
osobnie = c(w15_25_mean, w26_36_mean, w37_47_mean, w48_58_mean, w59_69_mean, w70_80_mean),
przyjaciele = c(w15_25_mean_przyjaciele, w26_36_mean_przyjaciele, w37_47_mean_przyjaciele, w48_58_mean_przyjaciele, w59_69_mean_przyjaciele, w70_80_mean_przyjaciele),
dzieci = c(w15_25_mean_dzieci, w26_36_mean_dzieci, w37_47_mean_dzieci, w48_58_mean_dzieci, w59_69_mean_dzieci, w70_80_mean_dzieci),
rodzina = c(w15_25_mean_rodzina, w26_36_mean_rodzina, w37_47_mean_rodzina, w48_58_mean_rodzina, w59_69_mean_rodzina, w70_80_mean_rodzina),
partner = c(w15_25_mean_partner, w26_36_mean_partner, w37_47_mean_partner, w48_58_mean_partner, w59_69_mean_partner, w70_80_mean_partner),
współpracownicy = c(w15_25_mean_współpracownicy, w26_36_mean_współpracownicy, w37_47_mean_współpracownicy, w48_58_mean_współpracownicy, w59_69_mean_współpracownicy, w70_80_mean_współpracownicy)
)
model3 <- lm(df_mean$wiek~df_mean$osobnie, dane = df_mean)
summary(model3)
##
## Call:
## lm(formula = df_mean$wiek ~ df_mean$osobnie, dane = df_mean)
##
## Residuals:
## 1 2 3 4 5 6
## -6.320 3.021 5.267 -0.733 -2.721 1.487
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -30.70413 8.31261 -3.694 0.020951 *
## df_mean$osobnie 0.22583 0.02337 9.665 0.000641 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.662 on 4 degrees of freedom
## Multiple R-squared: 0.9589, Adjusted R-squared: 0.9487
## F-statistic: 93.41 on 1 and 4 DF, p-value: 0.0006412
cor_val <- cor(df_mean$wiek, df_mean$osobnie)
kable(data.frame(correlation = sprintf("%.2f (korelację pomiędzy wiek a osobnie)", cor_val)))%>%
kable_styling()
| correlation |
|---|
| 0.98 (korelację pomiędzy wiek a osobnie) |
ggplot(df_mean, aes(x = wiek, y = osobnie)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
ggtitle("Linear relationship between Time spent alone and Age")
shapiro.test(model3$residuals)
##
## Shapiro-Wilk normality test
##
## data: model3$residuals
## W = 0.98558, p-value = 0.9757
Test Shapiro Wilka nie odrzuca hipotezy o normalności reszt modelu (p-value > 0.05).
bptest(model3)
##
## studentized Breusch-Pagan test
##
## data: model3
## BP = 2.9681, df = 1, p-value = 0.08492
gqtest(model3, order.by = fitted(model3), data=df_mean)
##
## Goldfeld-Quandt test
##
## data: model3
## GQ = 0.23638, df1 = 1, df2 = 1, p-value = 0.7119
## alternative hypothesis: variance increases from segment 1 to 2
hmctest(model3)
##
## Harrison-McCabe test
##
## data: model3
## HMC = 0.88325, p-value = 0.949
We wszystkich prypadkach p-value > 0.05, wyniki te sugerują, że założenie o stałej wariancji modelu regresji liniowej jest spełnione w przypadku modelu3
dwtest(model3, data=df_mean)
##
## Durbin-Watson test
##
## data: model3
## DW = 1.7244, p-value = 0.1356
## alternative hypothesis: true autocorrelation is greater than 0
bgtest(model3, order =3, data=df_mean)
##
## Breusch-Godfrey test for serial correlation of order up to 3
##
## data: model3
## LM test = 4.7027, df = 3, p-value = 0.1949
Test Durbina-Watsona i test Breuscha-Godfreya dla korelacji seryjnej rzędu do 3 mają wartości p odpowiednio 0,1356 i 0,1949. Te wartości p są większe niż 0,05, co sugeruje, że nie ma wystarczających dowodów, aby stwierdzić, że w resztach modelu występuje autokorelacja.
resettest(model3, data=df_mean, type='regressor')
##
## RESET test
##
## data: model3
## RESET = 2.6148, df1 = 2, df2 = 2, p-value = 0.2766
raintest(model3)
##
## Rainbow test
##
## data: model3
## Rain = 19.867, df1 = 3, df2 = 1, p-value = 0.1631
harvtest(model3, order.by = ~fitted(model3))
##
## Harvey-Collier test
##
## data: model3
## HC = 1.6402, df = 3, p-value = 0.1995
Wartości p testu RESET (0,2766) i testu Rainbow (0,1631) oraz testu Harveya-Colliera (0,1995) sugerują, że nie ma wystarczających dowodów na odrzucenie hipotezy zerowej o liniowości modelu.
Na podstawie modelu3 możemy stwierdzić, że w modelu nie występują problemy z nieliniowością czy heteroscedastycznością. I na podstawie naszych wykresów możemy powiedzieć, że zmienne są bezpośrednio związane z wiekiem osoby, a na podstawie naszych danych, im starsza jest osoba, tym więcej czasu spędza ze swoim partnerem, podczas gdy czas spędzony z przyjaciółmi lub współpracownikami maleje.